home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
021-030
/
amok25
/
beeper
/
beeper.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
4KB
|
152 lines
(*
:Program. Beeper
:Author. Philippe Gressly (Volker Rudolph)
:Address. Näfenhaus CH 8926 Kappel a/A
:Phone.
:ShortCut. [Philu]
:Version. 1.0
:Date. 1.10.1989
:Copyright. PD
:Language. Modula-II
:Translator. M2Amiga 3.2d
:Imports. ExecSupport, Hardware, DOS;
:Contents. Die Tasten melden sich akkustisch.
*)
MODULE Beeper;
(* $S- *)
FROM Arts IMPORT TermProcedure, Assert, Terminate, CurrentLevel;
FROM Exec IMPORT OpenDevice, CloseDevice, DoIO, Forbid, Permit,
AllocSignal, FreeSignal, Signal, FindTask, Wait,
Interrupt, IOStdReqPtr, MsgPortPtr, TaskPtr,
MemReqs, MemReqSet, AllocMem, FreeMem, Byte;
FROM ExecSupport IMPORT CreatePort, CreateStdIO, DeletePort, DeleteStdIO;
FROM Input IMPORT inputName, addHandler, remHandler;
FROM InputEvent IMPORT InputEventPtr, Qualifiers, QualifierSet, Class;
FROM SYSTEM IMPORT ADR, ADDRESS, LONGSET, INLINE, REG, SETREG;
FROM DOS IMPORT Delay;
FROM Hardware IMPORT Custom, custom, DmaFlagSet, DmaFlags;
VAR handlerStuff:Interrupt;
inputPort:MsgPortPtr;
inputReq:IOStdReqPtr;
sigNum:LONGINT;
signal:LONGSET;
myTask:TaskPtr;
Ende: BOOLEAN; (* CTRL F10 pressed. Quit the program now. *)
Wave0 : POINTER TO ARRAY [0..1] OF Byte;
sig: LONGSET;
PROCEDURE InputHandler():InputEventPtr;
VAR
event:InputEventPtr;
BEGIN
event := ADDRESS(REG(8)); (* a0:InputEventPtr *)
Forbid;
WITH event^ DO
IF (class = rawkey) AND (code < 60H) THEN
Signal(myTask,signal)
END; (* IF *)
IF (class = rawkey) AND (code = 59H) AND (control IN qualifier) THEN
Ende := TRUE
END;
END; (* WITH *)
Permit;
RETURN event;
END InputHandler;
(* $E- *)
PROCEDURE InputHandlerInterface;
BEGIN
INLINE(048E7H, 03F3EH); (* movem.l d2-d7/a2-a6,-(sp) *)
SETREG(0,InputHandler()); (* d0 : InputHandler() *)
INLINE(04CDFH, 07CFCH); (* movem.l (sp)+,d2-d7/a2-a6 *)
INLINE(04E75H); (* rts *)
END InputHandlerInterface;
PROCEDURE RemHandler;
BEGIN
IF inputReq # NIL THEN
WITH inputReq^ DO
IF device # NIL THEN
command := remHandler;
data := ADR(handlerStuff);
DoIO(inputReq);
CloseDevice(inputReq);
END; (* IF *)
END; (* WITH *)
DeleteStdIO(inputReq);
inputReq := NIL;
END; (* IF *)
IF inputPort # NIL THEN
DeletePort(inputPort);
inputPort := NIL;
END; (* IF *)
IF signal # LONGSET{} THEN
FreeSignal(sigNum);
signal := LONGSET{};
END; (* IF *)
END RemHandler;
BEGIN (* beeper main routine *)
Ende := FALSE;
myTask := FindTask(NIL);
TermProcedure(RemHandler);
(* einfache Rechteckskurve *)
Wave0 := AllocMem(2, MemReqSet{chip});
Assert(Wave0 # NIL, ADR("No Chip Mem left"));
Wave0^[0] := 127; Wave0^[1] := -127;
inputPort := CreatePort(ADR("BeepKey.port"),0);
inputReq := CreateStdIO(inputPort);
OpenDevice(ADR(inputName),0,inputReq,LONGSET{});
Assert(inputReq^.error = 0,ADR("AddHandler: Can't open input.device"));
WITH handlerStuff DO
code := InputHandlerInterface;
node.pri := 60;
node.name := ADR("BeepKey.handler");;
END; (* WITH *)
inputReq^.command := addHandler;
inputReq^.data := ADR(handlerStuff);
DoIO(inputReq);
Assert(inputReq^.error = 0,ADR("AddHandler: Can't add handler"));
sigNum := AllocSignal(-1);
Assert(sigNum # -1,ADR("AddHandler: Can't get signal"));
signal := LONGSET{sigNum};
REPEAT
sig := Wait(signal);
(* Sound *)
custom.aud[1].acptr := Wave0;
custom.aud[1].aclen := 1;
custom.aud[1].acvol := 64;
custom.aud[1].acper := 650;
Forbid;
custom.dmacon := DmaFlagSet{dmaSet, master, aud1};
Delay(2);
custom.dmacon := DmaFlagSet{aud1};
Permit
UNTIL Ende;
RemHandler;
FreeMem(Wave0, 1);
custom.dmacon := DmaFlagSet{aud1}; (* Sound off in case... *)
Terminate(CurrentLevel())
END Beeper.